perm filename SC.OL2[P11,LCS] blob sn#568825 filedate 1981-02-28 generic text, type T, neo UTF8
C>LM=2 RM=78 J=N TM=1 BM=66
C ***** MSS SCANNER ******* SCN/FOR *********
      SUBROUTINE SCANR
      DIMENSION IQ(10),LRUD(4)
      COMMON /ALF/INP(72),ML
	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
	1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
     1 /SCX/JALPHA(30),JX,RA,JZ,IRHY,RB,KA,KB,IZ
     1 /JCHAR/IXX,ISEMI,JBLA,IG
      COMMON /SC/J,LSC,MK
     1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
     1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
      EQUIVALENCE  (IQ(1),VX(41)),(VX1,VX(1)),(VX2,VX(2)),(LDN,LRUD(4))
      DATA LRUD/'L','R','U','D'/
C  FOR LEFT, RIGHT, UP, DOWN, EDIT
      NNUM=-1
      ISKP=0
      JJ=0
      XMINUS=1.
C  LEAVES BLANK WHEN REST.
999      DECI=-1
      M=0
2799  N=INP(ML)
899   ML=ML+1
781   IF(N.EQ.'/')N=ISEMI
C   FOR MOTIVIC TRANFORMATIONS
      IF(N.EQ.'*')GO TO 751
      IF(N.EQ.ISEMI)GO TO 751
C  '*' AND '/' ADDED ABOVE 4/18/73
      IF(N.NE.LXX)GO TO 22
      IF(JN)GO TO 22
      IF(ISKP.EQ.0)GO TO 210
      ML=ML-1
        GO TO 202
22    IF(N.EQ.IBLA)GO TO 4702
      IF(N.NE.',')GO TO 510
4702  IF(ISKP)202,2799,2799
512   ML=ML+1
      IF(INP(ML).EQ.ISEMI)RETURN   
      GO TO 512

510   IF(JN.GE.0)GO TO 173
C  SKIP(JN=+1) IF NOT COMING FROM 'EDIT'
      JN=1
      DO 702 K=1,4
702   IF(N.EQ.LRUD(K))GO TO 703
C  FINDS L, R, U, D
        IF(N.GT.IBLA)GO TO 899
C  GO TO 703 IF REALLY A LETTER, ELSE MOVE UP POINTER
703   JJ=JJ+1
C   YOU CAN TYPE THE FULL WORD
      IF(K.NE.4)GO TO 77
      IF(INP(ML).EQ.LEE)K=99
C   'DE'=DELETE
77    IF(N.EQ.'E')K=55
C   'E'= EDIT
      IF(N.EQ.LCC)K=2222
      IF(N.EQ.LXX)K=222
C  'C'=COPY, 'X'=EXIT FROM EDIT MODE
      VX(JJ)=K
704   IF(INP(ML).EQ.JBLA)GO TO 2799
      IF(INP(ML).GT.0)GO TO 2799
C   IF NEXT CHAR. IS A LETTER(NEG.), SKIP IT.
C  PUT COMMA ERASER IN SCX.
      ML=ML+1
C  SO IT WILL SKIP 'D' AND 'EL' IN 'EDIT' AND 'DEL'
      GO TO 704
173   K=NALF(N)
      IF(N.GT.0)GO TO 1410
      IF(K.EQ.18)GO TO 73
C   JUMP IF A REST OR OTHER R'S
      IF(MODE.EQ.2)GO TO 144
C                       ;YOU CAN TYPE 'S', ETC., FOR SIXTEENTH ETC., RHYTHM.
C                       ;  JUMP IF NOT A LETTER
 
C notes =  1xyz.0   x=accidental, yz=note num.,  negative=chord note
C rest  =  2xyz.0   z=0=ordinary, =1=invis., =2=whole, =3=repeat bar
C                   =4=down, =5=up, -2xyz=num. of meas. rest
C clefs =  3xyz.0   z=0=treble, =1=bass, =2=alto, =3=tenor, neg.=invis.
C use TRE,BAS,ALT,TEN for clefs with no change to note levels.(4,5,6,7)
C bars  =  4xyz.0   z=num. of staves up, neg.=dbl.bar
C ksig  = 17xyz.0   z=num. of accis.,  pos.=#, neg.=b,  x=1 for naturals.
C meter = 18xyz.n   xy=top num, zn=bottom num   (DONE IN SCMSS)
C stem  =  5xyz.0   YZ=10=stem up,  =20=stem down
C staff =  5xyz.0   z=0=return to norm., =1=lower stf., =2=upper stf.
 
      IF(K.LT.8)GO TO 15
C   JUMP IF A POSSIBLE NOTE
      IF(K.NE.11)GO TO 16
C   JUMP IF NOT A KSIG
	CALL SCAN4
	RETURN

C NOW LOOK FOR 'I'
16    IF(K.NE.9)GO TO 2
      VX(1)=22.
C   FOR EDIT I21 ETC.
      GO TO 2799
C NOW 'M'
2     IF(K.NE.13)GO TO 3
	CALL BARS
C  ***** BARS =4000  ******
	GO TO 512

3     IF(K.GT.16)GO TO 4
C   JUMP IF NOT FOR 'PROXIMITY' MODE
      NSWCH=K-15
      GO TO 2799
C           TO SWITCH ALWAYS USE OCT.#  /PBF4/  /OE5/  P=PROXIMITY, O=ORDINARY
4	IF(SCAN2(QZ))2799,4002,512

15      N=INP(ML)
        IF(K.NE.2)GO TO 5
C       CAIN K,2        ;IF(1ST LETR.NE.'B')GO TO S5
        IF(N.NE.LAA)GO TO 5
C   JUMP IF NOT BASS CLEF
        QZ=3001.
C       MOVE    02,[3001.0]             ;BASS CLEF=3001
4002    N=INP(ML+1)
C   GET 3RD CHAR.
        IF(N.EQ.JBLA.OR.N.EQ.'/'.OR.N.EQ.ISEMI)GO TO 5002
C   IF 3RD CHAR IS SIGNIFICANT THEN SPECIAL CLEF
C  4,5,6,7 = 0,1,2,3 BUT NO INFLUENCE ON NOTE LEVEL
        QZ=QZ+4.
        ML=ML+1
5002    VX(1)=QZ
51     IF(XMINUS.LT.0)VX(1)=-VX(1)
C   TYPE '-BA' FOR INVISIBLE BASS CLEF, ETC.
        GO TO 512
5     IF(N.NE.LEL)GO TO 6
C   JUMP IF NOT ALTO CLEF
        QZ=3002.0
        GO TO 4002
6	CALL SCAN3(NSWCH)

4410    IF(INP(ML).EQ.ISEMI)RETURN   
C  ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
        GO TO 310

210   JJ=JJ+1
      IF(JJ.EQ.1)GO TO 3310
      XMINUS=1.
      VX(JJ)=0
C   'X N1,N2' MAY REPLACE 'REP N1,N2'.  N2=0 BECOMES N2=2
        GO TO 310
C   JUMP IF A LETTER
1410  IF(N.NE.'-')GO TO 544
         XMINUS=-1.
       IF(JJ.EQ.0)GO TO 2799
C -- FOR '-BA' ETC.
      IF(MODE.EQ.1)GO TO 644
C [FOR AUTO OCT. SYS.]
         GO TO 2799
544   IF(MODE.NE.1)GO TO 14
      IF(N.NE.'+')GO TO 14
644   VX4=7.
      K=NALF(INP(ML))
      IF(K.GT.9.OR.K.LT.0)GO TO 744
      VX4=K
      ML=ML+1
744   IF(N.NE.'+')VX4=-VX4
      GO TO 2799
C   DEFAULT IS OCTAVE. (+ OR - 7)
144   TRIP=0
444   IF(K.NE.8)GO TO 1444
      VX1=2.
      GO TO 2444
1444  IF(K.NE.4)GO TO 3444
      VX1=.5
      GO TO 2444
3444  IF(K.NE.5)GO TO 3445
      VX1=8.
      GO TO 2444
3445  IF(K.NE.7)GO TO 4444
      VX1=88.
      GO TO 2444
4444  IF(K.NE.19)GO TO 5444
      VX1=16.
      GO TO 2444
5444  IF(K.NE.20)GO TO 244
         VX1=12.
         N=INP(ML)
        IF(N.EQ.LBL)GO TO 2444
        IF(N.EQ.ISEMI)GO TO 2444
      IF(N.EQ.1)GO TO 2444
C (DOT WAS CHANGED TO 1)
      IF(N.EQ.IXX)GO TO 2444
         TRIP=-1.
         ML=ML+1
         K=NALF(N)
      N=INP(ML)
      GO TO 444
244   IF(K.EQ.23)VX1=1.
        IF(K.EQ.17)VX1=4.
C TS=24TH, TQ=6, TH=3.
C   FOR S,E,Q,H,W,D,T RHYTH.  'T'(K=20) =TRIPLET  D=DBL WHL NOTE
2444    IF(TRIP.LT.0)VX1=VX1*1.5
344   JJ=JJ+1
      GO TO 1310
14    ISKP=-1
       IF(N.NE.'.')GO TO 79
       DECI=M
      GO TO 75
79    M=M+1
       IQ(M)=NALF(N)
75    IF(N.EQ.ISEMI)GO TO 751
       IF(INP(ML).NE.1)GO TO 2799
751   IF(ISKP.EQ.0)RETURN    
202   IF(DECI.NE.-1.)GO TO 302
       DECI=0
      GO TO 402
302   DECI=M-DECI
402   RRN=0
       REXP=M-1
       IF(M.LT.1)M=1
        DO 171 K=1,M
        IF(REXP.GT.1)GO TO 1
       RRV=10
       IF(REXP.EQ.0)RRV=1
       GO TO 11
1     RRV=10.**REXP
11    RRN=RRN+IQ(K)*RRV
171     REXP=REXP-1.
        A=10.**DECI
        IF(DECI.EQ.0)A=1.
       JJ=JJ+1
       VX(JJ)=RRN/A*XMINUS
       JN=-JN
C   SETS IT TO -1 FOR L,R,U,D EDIT ROUTINE
       IF(MODE.NE.2)XMINUS=1.
C************: MODE #?
C  ONLY ONE - NEEDED FOR RHY.COMPOSITE
1310  IF(INP(ML).NE.1)GO TO 310
      VX(JJ)=VX(JJ)+1000.
C 1000 IS ADDED FOR EACH DOT. NO MORE COMPOSITES!
        ML=ML+1
        GO TO 1310
206   ML=ML+2
3310  VX(1)=-99.
310      ISKP=0
      IF(N.NE.ISEMI)GO TO 999
      RETURN

73    JJ=JJ+1
        K=INP(ML)
        IF(K.EQ.LEE)GO TO 206
C  NEXT IS FOR A REST/R/ OR /RI/ FOR INVIS. REST
       IF(K.EQ.LDD)GO TO 1073
C    /RD/ OR /RU/ = REST 6 DOWN OR 6 UP.
       IF(K.EQ.LUU)GO TO 1173
       IF(K.EQ.LII)GO TO 573
       IF(K.EQ.LWW)GO TO 273
C   /RW/ MAKES WHOLE REST REGARDLESS OF TIME VALUE GIVEN.
      IF(K.EQ.LRR)GO TO 1273
C   /RR/ MAKES REPEAT BAR SIGN (REST=-4)
C     ; *** ADD NUMBERS LATER *****;  22932
       K=NALF(K)
       IF(K.LT.0)GO TO 673
       IF(K.GE.10)GO TO 673
973   KV=NALF(INP(ML+1))
C   FOR 3-DIG. NUMBS.   CAN TAKE NUM UP TO 999 FOR RESTS.
       IF(KV.LT.0)GO TO 873
      IF(KV.GE.10)GO TO 873
        ML=ML+1
        K=K*10+KV
C 15 IS K FOR NOW AND K IS IV
      GO TO 973
873   QQ=-2000.-QQ
C S873:   ADDI 15,=2000           ; QQ IS AC15 NOW.  RW =2002
C       MOVNS 15         FLTR 15,15
        GO TO 473
673     QQ=2000.
C ORDINARY REST
      GO TO 373
573    QQ=2001.
C  INVISIBLE REST
       GO TO 473
273    QQ=2002.
C   WHOLE REST (NO MATTER WHAT RHYTH.)
473   ML=ML+1
373   VX(JJ)=QQ
      GO TO 4410
1073  QQ=2004.
C  RD = REST DONW  2004
       GO TO 473
1173   QQ=2005.
C   RU = REST UP  2005
       GO TO 473
1273   QQ=2003.
C   RR = BAR REPEAT SIGN
        GO TO 473
      END